home *** CD-ROM | disk | FTP | other *** search
/ NeXTSTEP 3.3 (Developer)…68k, x86, SPARC, PA-RISC] / NeXTSTEP 3.3 Dev Intel.iso / NextDeveloper / Source / GNU / emacs / src / sunfns.c < prev    next >
C/C++ Source or Header  |  1992-10-21  |  15KB  |  530 lines
  1. /* Functions for Sun Windows menus and selection buffer.
  2.    Copyright (C) 1987 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. Author: Jeff Peck, Sun Microsystems, Inc. <peck@sun.com>
  21.     This file provides selection and menu support in SunView
  22.     [also a function to change the sunview cursor]
  23.     
  24. Original ideas by David Kastan and Eric Negaard, SRI International
  25. Major help from: Steve Greenbaum, Reasoning Systems, Inc.
  26.              <froud@kestrel.arpa>
  27. who first discovered the Menu_Base_Kludge.
  28.     Modified 12/91    Jeff Peck to compile without sunview libraries:
  29.     #define NO_SUNVIEW       
  30.     disables SunView support leaving just sit-for-millisecs, sleep-for-millisecs
  31.  */
  32.  
  33. /*
  34.  *    Emacs Lisp-Callable functions for sunwindows
  35.  */
  36. #include "config.h"
  37.  
  38. #include <stdio.h>
  39. #include <errno.h>
  40. #include <signal.h>
  41.  
  42. #ifndef NO_SUNVIEW
  43. #include <sunwindow/window_hs.h>
  44. #include <suntool/selection.h>
  45. #include <suntool/menu.h>
  46. #include <suntool/walkmenu.h>
  47. #include <suntool/frame.h>
  48. #include <suntool/window.h>
  49. #endif    /* NO_SUNVIEW */
  50.  
  51. #include <sys/time.h>        /* for tv_sec, tv_usec */
  52. #include <fcntl.h>
  53. #undef NULL /* We don't need sunview's idea of NULL */
  54. #include "lisp.h"
  55. #include "window.h"
  56. #include "buffer.h"
  57. #include "termhooks.h"
  58.  
  59. #ifndef NO_SUNVIEW
  60. /* conversion to/from character & screen coordinates */
  61. /* From Gosling Emacs SunWindow driver by Chris Torek */
  62.  
  63. /* Chars to screen coords.  Note that we speak in zero origin. */
  64. #define CtoSX(cx) ((cx) * Sun_Font_Xsize)
  65. #define CtoSY(cy) ((cy) * Sun_Font_Ysize)
  66.  
  67. /* Screen coords to chars */
  68. #define StoCX(sx) ((sx) / Sun_Font_Xsize)
  69. #define StoCY(sy) ((sy) / Sun_Font_Ysize)
  70.  
  71. #endif    /* NO_SUNVIEW */
  72. #define CHECK_GFX(x) if((win_fd<0)&&(Fsun_window_init(),(win_fd<0)))return(x)
  73. int win_fd = -1;
  74. #ifndef NO_SUNVIEW 
  75. struct pixfont *Sun_Font;    /* The font */
  76. int Sun_Font_Xsize;        /* Width of font  */
  77. int Sun_Font_Ysize;        /* Height of font */
  78.  
  79. #define Menu_Base_Kludge    /* until menu_show_using_fd gets fixed */
  80. #ifdef  Menu_Base_Kludge
  81. static Frame Menu_Base_Frame;
  82. static int Menu_Base_fd;
  83. static Lisp_Object sm_kludge_string;
  84. #endif    /* Menu_Base_Kludge */
  85. struct cursor CurrentCursor;    /* The current cursor */
  86.  
  87. static short CursorData[16];    /* Build cursor here */
  88. static mpr_static(CursorMpr, 16, 16, 1, CursorData);
  89. static struct cursor NewCursor = {0, 0, PIX_SRC ^ PIX_DST, &CursorMpr};
  90.  
  91. #define RIGHT_ARROW_CURSOR    /* if you want the right arrow */
  92. #ifdef RIGHT_ARROW_CURSOR
  93. /* The default right-arrow cursor, with XOR drawing. */
  94. static short ArrowCursorData[16] = {
  95.   0x0001,0x0003,0x0007,0x000F,0x001F,0x003F,0x007F,0x000F,
  96.   0x001B,0x0019,0x0030,0x0030,0x0060,0x0060,0x00C0,0x00C0};
  97. static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData);
  98. struct cursor DefaultCursor = {15, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
  99.  
  100. #else
  101. /* The default left-arror cursor, with XOR drawing. */
  102. static short ArrowCursorData[16] = {
  103.     0x8000,0xC000,0xE000,0xF000,0xF800,0xFC00,0xFE00,0xF000,
  104.     0xD800,0x9800,0x0C00,0x0C00,0x0600,0x0600,0x0300,0x0300};
  105. static mpr_static(ArrowCursorMpr, 16, 16, 1, ArrowCursorData);
  106. struct cursor DefaultCursor = {0, 0, PIX_SRC ^ PIX_DST, &ArrowCursorMpr};
  107. #endif    /* RIGHT_ARROW_CURSOR */
  108. #endif    /* NO_SUNVIEW */
  109.  
  110. /*
  111.  *    Initialize window
  112.  */
  113. DEFUN ("sun-window-init", Fsun_window_init, Ssun_window_init, 0, 1, 0,
  114. #ifndef NO_SUNVIEW 
  115.        "One time setup for using Sun Windows with mouse.\n\
  116. Unless optional argument FORCE is non-nil, is a noop after its first call.\n\
  117. Returns a number representing the file descriptor of the open Sun Window,\n\
  118. or -1 if can not open it."
  119. #else
  120.        "One time setup for using Sun Windows with mouse.\n\
  121. Unless optional argument FORCE is non-nil, is a noop after its first call.\n\
  122. Dummy version, compiled with NO_SUNWINDOW, returns -1."
  123. #endif    /* NO_SUNVIEW */
  124.        )
  125.       (force)
  126.       Lisp_Object force;
  127. {
  128.   char *cp;
  129.   static int already_initialized = 0;
  130. #ifndef NO_SUNVIEW 
  131.   if ((! already_initialized) || (!NULL(force))) {
  132.     cp = getenv("WINDOW_GFX");
  133.     if (cp != 0) win_fd = open(cp, 2);
  134.     if (win_fd > 0)
  135.       {
  136.     Sun_Font = pf_default();
  137.     Sun_Font_Xsize = Sun_Font->pf_defaultsize.x;
  138.     Sun_Font_Ysize = Sun_Font->pf_defaultsize.y;
  139.     Fsun_change_cursor_icon (Qnil);    /* set up the default cursor */
  140.     already_initialized = 1;
  141. #ifdef  Menu_Base_Kludge
  142.  
  143.     /* Make a frame to use for putting the menu on, and get its fd. */
  144.     Menu_Base_Frame = window_create(0, FRAME,
  145.                     WIN_X, 0, WIN_Y, 0,
  146.                     WIN_ROWS, 1, WIN_COLUMNS, 1,
  147.                     WIN_SHOW, FALSE,
  148.                     FRAME_NO_CONFIRM, 1,
  149.                     0);
  150.     Menu_Base_fd = (int) window_get(Menu_Base_Frame, WIN_FD);
  151. #endif    /* Menu_Base_Kludge */
  152.       }
  153.   }
  154. #endif    /* NO_SUNVIEW */
  155.   return(make_number(win_fd));
  156. }
  157.  
  158. /*
  159.  *    Mouse sit-for (allows a shorter interval than the regular sit-for
  160.  *    and can be interrupted by the mouse)
  161.  */
  162. DEFUN ("sit-for-millisecs",
  163.        Fsit_for_millisecs,
  164.        Ssit_for_millisecs, 1, 1, 0,
  165.    "Like sit-for, but ARG is milliseconds. \n\
  166. Perform redisplay, then wait for ARG milliseconds or until\n\
  167. input is available.  Returns t if wait completed with no input.\n\
  168. Redisplay does not happen if input is available before it starts.")
  169.     (n)
  170.     Lisp_Object n;
  171. {
  172.   struct timeval Timeout;
  173.   int waitmask = 1;
  174.   
  175.   CHECK_NUMBER (n, 0);
  176.   Timeout.tv_sec = XINT(n) / 1000;
  177.   Timeout.tv_usec = (XINT(n) - (Timeout.tv_sec * 1000)) * 1000;
  178.  
  179.   if (detect_input_pending()) return(Qnil);
  180.   redisplay ();
  181.   /*
  182.    *    Check for queued keyboard input/mouse hits again
  183.    *    (A bit screen update can take some time!)
  184.    */
  185.   if (detect_input_pending()) return(Qnil);
  186.   select(1,&waitmask,0,0,&Timeout);
  187.   if (detect_input_pending()) return(Qnil);
  188.   return(Qt);
  189. }
  190.  
  191. /*
  192.  *   Sun sleep-for (allows a shorter interval than the regular sleep-for)
  193.  */
  194. DEFUN ("sleep-for-millisecs", 
  195.     Fsleep_for_millisecs,
  196.     Ssleep_for_millisecs, 1, 1, 0,
  197.    "Pause, without updating display, for ARG milliseconds.")
  198.     (n)
  199.     Lisp_Object n;
  200. {
  201.   unsigned useconds;
  202.  
  203.   CHECK_NUMBER (n, 0);
  204.   useconds = XINT(n) * 1000;
  205.   usleep(useconds);
  206.   return(Qt);
  207. }
  208.  
  209. DEFUN ("update-display", Fupdate_display, Supdate_display, 0, 0, 0,
  210.        "Perform redisplay.")
  211.      ()
  212. {
  213.   redisplay_preserve_echo_area ();
  214.   return(Qt);
  215. }
  216.  
  217. #ifndef NO_SUNVIEW 
  218. /*
  219.  *    Change the Sun mouse icon
  220.  */
  221. DEFUN ("sun-change-cursor-icon",
  222.     Fsun_change_cursor_icon,
  223.     Ssun_change_cursor_icon, 1, 1, 0,
  224.   "Change the Sun mouse cursor icon.  ICON is a lisp vector whose 1st element\n\
  225. is the X offset of the cursor hot-point, whose 2nd element is the Y offset\n\
  226. of the cursor hot-point and whose 3rd element is the cursor pixel data\n\
  227. expressed as a string.  If ICON is nil then the original arrow cursor is used")
  228.      (Icon)
  229.      Lisp_Object Icon;
  230. {
  231.   register unsigned char *cp;
  232.   register short *p;
  233.   register int i;
  234.   Lisp_Object X_Hot, Y_Hot, Data;
  235.   
  236.   CHECK_GFX (Qnil);
  237.   /*
  238.    *    If the icon is null, we just restore the DefaultCursor
  239.    */
  240.   if (NULL(Icon)) 
  241.     CurrentCursor = DefaultCursor;
  242.   else {
  243.     /*
  244.      *    extract the data from the vector
  245.      */
  246.     CHECK_VECTOR (Icon, 0);
  247.     if (XVECTOR(Icon)->size < 3) return(Qnil);
  248.     X_Hot = XVECTOR(Icon)->contents[0];
  249.     Y_Hot = XVECTOR(Icon)->contents[1];
  250.     Data = XVECTOR(Icon)->contents[2];
  251.     
  252.     CHECK_NUMBER (X_Hot, 0);
  253.     CHECK_NUMBER (Y_Hot, 0);
  254.     CHECK_STRING (Data, 0);
  255.     if (XSTRING(Data)->size != 32) return(Qnil);
  256.     /*
  257.      *    Setup the new cursor
  258.      */
  259.     NewCursor.cur_xhot = X_Hot;
  260.     NewCursor.cur_yhot = Y_Hot;
  261.     cp = XSTRING(Data)->data;
  262.     p = CursorData;
  263.     i = 16;
  264.     while(--i >= 0)
  265.       *p++ = (cp[0] << 8) | cp[1], cp += 2;
  266.     CurrentCursor = NewCursor;
  267.   }
  268.   win_setcursor(win_fd, &CurrentCursor);
  269.   return(Qt);
  270. }
  271.  
  272. /*
  273.  *    Interface for sunwindows selection
  274.  */
  275. static Lisp_Object Current_Selection;
  276.  
  277. static
  278. sel_write (sel, file)
  279.      struct selection *sel;
  280.      FILE *file;
  281. {
  282.   fwrite (XSTRING (Current_Selection)->data, sizeof (char), 
  283.       sel->sel_items, file);
  284. }
  285.  
  286. static
  287. sel_clear (sel, windowfd)
  288.      struct selection *sel;
  289.      int windowfd;
  290. {
  291. }
  292.  
  293. static
  294. sel_read (sel, file)
  295.      struct selection *sel;
  296.      FILE *file;
  297. {
  298.   register int i, n;
  299.   register char *cp;
  300.   
  301.   Current_Selection = make_string ("", 0);
  302.   if (sel->sel_items <= 0)
  303.     return (0);
  304.   cp = (char *) malloc(sel->sel_items);
  305.   if (cp == (char *)0) {
  306.     error("malloc failed in sel_read");
  307.     return(-1);
  308.   }
  309.   n = fread(cp, sizeof(char), sel->sel_items, file);
  310.   if (n > sel->sel_items) {
  311.     error("fread botch in sel_read");
  312.     return(-1);
  313.   } else if (n < 0) {
  314.     error("Error reading selection.");
  315.     return(-1);
  316.   }
  317.   /*
  318.    * The shelltool select saves newlines as carrige returns,
  319.    * but emacs wants newlines.
  320.    */
  321.   for (i = 0; i < n; i++) 
  322.     if (cp[i] == '\r') cp[i] = '\n';
  323.  
  324.   Current_Selection = make_string (cp, n);
  325.   free (cp);
  326.   return (0);
  327. }
  328.  
  329. /*
  330.  *    Set the window system "selection" to be the arg STRING
  331.  */
  332. DEFUN ("sun-set-selection", Fsun_set_selection, Ssun_set_selection, 1, 1,
  333.        "sSet selection to: ",
  334.   "Set the current sunwindow selection to STRING.")
  335.      (str)
  336.      Lisp_Object str;
  337. {
  338.   struct selection selection;
  339.  
  340.   CHECK_STRING (str, 0);
  341.   Current_Selection = str;
  342.  
  343.   CHECK_GFX (Qnil);
  344.   selection.sel_type = SELTYPE_CHAR;
  345.   selection.sel_items = XSTRING (str)->size;
  346.   selection.sel_itembytes = 1;
  347.   selection.sel_pubflags = 1;
  348.   selection_set(&selection, sel_write, sel_clear, win_fd);
  349.   return (Qt);
  350. }
  351. /*
  352.  *    Stuff the current window system selection into the current buffer
  353.  */
  354. DEFUN ("sun-get-selection", Fsun_get_selection, Ssun_get_selection, 0, 0, 0,
  355.        "Return the current sunwindows selection as a string.")
  356.      ()
  357. {
  358.   CHECK_GFX (Current_Selection);
  359.   selection_get (sel_read, win_fd);
  360.   return (Current_Selection);
  361. }
  362.  
  363. Menu sun_menu_create();
  364.  
  365. Menu_item
  366. sun_item_create (Pair)
  367.      Lisp_Object Pair;
  368. {
  369.   /* In here, we depend on Lisp supplying zero terminated strings in the data*/
  370.   /* so we can just pass the pointers, and not recopy anything */
  371.  
  372.   Menu_item menu_item;
  373.   Menu submenu;
  374.   Lisp_Object String;
  375.   Lisp_Object Value;
  376.  
  377.   if (!CONSP(Pair)) wrong_type_argument(Qlistp, Pair);
  378.   String = Fcar(Pair);
  379.   CHECK_STRING(String, 0);
  380.   Value = Fcdr(Pair);
  381.   if(XTYPE(Value) == Lisp_Symbol)
  382.     Value = XSYMBOL(Value)->value;
  383.   if(XTYPE(Value) == Lisp_Vector) {
  384.     submenu = sun_menu_create (Value);
  385.     menu_item = menu_create_item
  386.       (MENU_RELEASE, MENU_PULLRIGHT_ITEM, XSTRING(String)->data, submenu, 0);
  387.   } else {
  388.     menu_item = menu_create_item
  389.       (MENU_RELEASE, MENU_STRING_ITEM, XSTRING(String)->data, Value, 0);
  390.   }
  391.   return menu_item;
  392. }
  393.  
  394. Menu 
  395. sun_menu_create (Vector)
  396.      Lisp_Object Vector;
  397. {
  398.   Menu menu;
  399.   int i;
  400.   CHECK_VECTOR(Vector,0);
  401.   menu=menu_create(0); 
  402.   for(i = 0; i < XVECTOR(Vector)->size; i++) {
  403.     menu_set (menu, MENU_APPEND_ITEM, 
  404.           sun_item_create(XVECTOR(Vector)->contents[i]), 0);
  405.   }
  406.   return menu;
  407. }
  408.  
  409. /*
  410.  *  If the first item of the menu has nil as its value, then make the
  411.  *  item look like a label by inverting it and making it unselectable.
  412.  *  Returns 1 if the label was made, 0 otherwise.
  413.  */
  414. int
  415. make_menu_label (menu)
  416.      Menu menu;
  417. {
  418.   int made_label_p = 0;
  419.  
  420.   if (( menu_get(menu, MENU_NITEMS) > 0 ) && /* At least one item */
  421.       ((Lisp_Object) menu_get(menu_get(menu, MENU_NTH_ITEM, 1),
  422.                   MENU_VALUE) == Qnil )) {
  423.       menu_set(menu_get(menu, MENU_NTH_ITEM, 1),
  424.            MENU_INVERT, TRUE,
  425.            MENU_FEEDBACK, FALSE,
  426.            0);
  427.       made_label_p = 1;
  428.     }
  429.   return made_label_p;
  430. }
  431.  
  432. /*
  433.  *    Do a pop-up menu and return the selected value
  434.  */
  435. DEFUN ("sun-menu-internal",
  436.        Fsun_menu_internal,
  437.        Ssun_menu_internal, 5, 5, 0,
  438.        "Set up a SunView pop-up menu and return the user's choice.\n\
  439. Arguments WINDOW, X, Y, BUTTON, and MENU.\n\
  440. *** User code should generally use sun-menu-evaluate ***\n\
  441. \n\
  442. Arguments WINDOW, X, Y, BUTTON, and MENU.\n\
  443. Put MENU up in WINDOW at position X, Y.\n\
  444. The BUTTON argument specifies the button to be released that selects an item:\n\
  445.    1 = LEFT BUTTON\n\
  446.    2 = MIDDLE BUTTON\n\
  447.    4 = RIGHT BUTTON\n\
  448. The MENU argument is a vector containing (STRING . VALUE) pairs.\n\
  449. The VALUE of the selected item is returned.\n\
  450. If the VALUE of the first pair is nil, then the first STRING will be used\n\
  451. as a menu label.")
  452.       (window, X_Position, Y_Position, Button, MEnu)
  453.       Lisp_Object window, X_Position, Y_Position, Button, MEnu;
  454. {
  455.   Menu menu;
  456.   int button, xpos, ypos;
  457.   Event event0;
  458.   Event *event = &event0;
  459.   Lisp_Object Value, Pair;
  460.   
  461.   CHECK_NUMBER(X_Position, 0);
  462.   CHECK_NUMBER(Y_Position, 1);
  463.   CHECK_WINDOW(window, 2);
  464.   CHECK_NUMBER(Button, 3);
  465.   CHECK_VECTOR(MEnu, 4);
  466.  
  467.   CHECK_GFX (Qnil);
  468.  
  469.   xpos = CtoSX (XWINDOW(window)->left + XINT(X_Position));
  470.   ypos = CtoSY (XWINDOW(window)->top  + XINT(Y_Position));
  471. #ifdef  Menu_Base_Kludge
  472.   {static Lisp_Object symbol[2];
  473.    symbol[0] = Fintern (sm_kludge_string, Qnil);
  474.    Pair = Ffuncall (1, symbol);
  475.    xpos += XINT (XCONS (Pair)->cdr);
  476.    ypos += XINT (XCONS (Pair)->car);
  477.  }
  478. #endif    /* Menu_Base_Kludge */
  479.  
  480.   button = XINT(Button);
  481.   if(button == 4) button = 3;
  482.   event_set_id   (event, BUT(button));
  483.   event_set_down (event);
  484.   event_set_x    (event, xpos);
  485.   event_set_y    (event, ypos);
  486.  
  487.   menu = sun_menu_create(MEnu);
  488.   make_menu_label(menu);
  489.  
  490. #ifdef  Menu_Base_Kludge
  491.   Value = (Lisp_Object) menu_show(menu, Menu_Base_Frame, event, 0);
  492. #else
  493. /* This confuses the notifier or something: */
  494.   Value = (Lisp_Object) menu_show_using_fd(menu, win_fd, event, 0);
  495. /*
  496.  * Right button gets lost, and event sequencing or delivery gets mixed up
  497.  * So, until that gets fixed, we use this <Menu_Base_Frame> kludge:
  498.  */
  499. #endif    /* Menu_Base_Kludge */
  500.   menu_destroy (menu);
  501.  
  502.   return ((int)Value ? Value : Qnil);
  503. }
  504. #endif    /* NO_SUNVIEW */
  505.  
  506. /*
  507.  *    Define everything
  508.  */
  509. syms_of_sunfns()
  510. {
  511. #ifndef NO_SUNVIEW
  512. #ifdef  Menu_Base_Kludge
  513.   /* i'm just too lazy to re-write this into C code */
  514.   /* so we will call this elisp function from C */
  515.   sm_kludge_string = make_pure_string ("sm::menu-kludge", 15);
  516. #endif    /* Menu_Base_Kludge */
  517.  
  518. #endif    /* NO_SUNVIEW */
  519.   defsubr(&Ssun_window_init);
  520.   defsubr(&Ssit_for_millisecs);
  521.   defsubr(&Ssleep_for_millisecs);
  522.   defsubr(&Supdate_display);
  523. #ifndef NO_SUNVIEW
  524.   defsubr(&Ssun_change_cursor_icon);
  525.   defsubr(&Ssun_set_selection);
  526.   defsubr(&Ssun_get_selection);
  527.   defsubr(&Ssun_menu_internal);
  528. #endif    /* NO_SUNVIEW */
  529. }
  530.